perm filename M[AP,DBL] blob sn#104026 filedate 1974-05-25 generic text, type T, neo UTF8
(FILECREATED "25-MAY-74 01:30:45" M 1829  

     changes to:  PULLOUT, LIST:JOIN, MFNS, FORSOME, MERGE:IN

     previous date: "23-MAY-74 22:54:36")


(DEFINEQ

(PULLOUT
  (LAMBDA (E L ETEMP)
    (COND
      ((PROGN (SETQ ETEMP (PULLOUT1 E L))
	      (NOT (EQUAL ETEMP L)))
	ETEMP)
      ((LISTP E)
	(EVAL (CONS SETINTERSECTION (MAPCAR E (FUNCTION (LAMBDA (EE)
						(LIST (QUOTE QUOTE)
						      (PULLOUT1 EE L))))))))
      (T L))))

(FORSOME
  (NLAMBDA (X IN XSET ACTION)
    (PROG (ESET EE EA)
          (SETQ ESET (EVAL XSET))
      LABELL
          (COND
	    ((NULL ESET)
	      (RETURN NIL)))
          (SET X (CAR ESET))
          (SETQ ESET (CDR ESET))
          (COND
	    ((AND (SETQ EA (EVAL ACTION))
		  (NOT (EQUAL EA FALSE)))
	      EA)
	    (T (GO LABELL))))))

(MERGE:IN
  (LAMBDA (E L F)
    (COND
      ((MEMBER E L)
	L)
      ((AND (LISTP E)
	    (LISTP (CAR E)))
	(MERGE:IN2 E L F))
      ((NULL L)
	(LIST E))
      ((APPLY* F E (CAR L))
	(CONS E L))
      (T (CONS (CAR L)
	       (MERGE:IN E (CDR L)
			 F))))))

(MERGE:IN2
  (LAMBDA (E L F)
    (COND
      (E (MERGE:IN (CAR E)
		   (MERGE:IN2 (CDR E)
			      L F)
		   F))
      (T L))))

(LIST:JOIN
  (LAMBDA (LL FL AL)
    (COND
      ((AND LL (ATOM (CAR LL))
	    (LISTP (CAR FL)))
	(LIST:JOIN AL (CONS LL FL)
		   NIL))
      (LL (LIST:JOIN (CDR LL)
		     (COND
		       ((ATOM (CAR LL))
			 (NCONC1 FL (CAR LL)))
		       ((OR (NULL FL)
			    (LISTP (CAR FL)))
			 (CONS (CAR LL)
			       FL))
		       ((LISTP (CAR LL))
			 (APPEND FL (CAR LL)))
		       (T FL))
		     AL))
      (AL (LIST:JOIN AL FL NIL))
      (T FL))))
)
  (LISPXPRINT (QUOTE MFNS)
	      T)
  (RPAQQ MFNS (PULLOUT FORSOME MERGE:IN MERGE:IN2 LIST:JOIN))
(PROGN (QUOTE JUSTEVALUATE)
(FILEMAP (NIL (158 1696 (PULLOUT 170 . 455) (FORSOME 459 . 814) (MERGE:IN 818 . 1088) (MERGE:IN2 1092 . 1226) (LIST:JOIN
1230 . 1693)))))
STOP